VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "cCopyThread"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit

'two Event-Naming-Conventions, for communication with the vbRichClients hidden cThreadProxy-Class (not reaching the clients, when raised)
Event CancelCheck(Cancel As Boolean)  'ask the hosting cThreadProxy, whether a client demanded Job-Cancelling
Event GetFactory(Factory As cFactory) 'ask the cThreadProxy, to deliver a RichClient-Factory-Instance regfree (not used here in this Demo)

'Userdefined-Event
Event Progress(ByVal Percent As Double, ByVal ProgrFileSizeInSrc As Currency, ByVal TotalFileSizeInSrc As Currency)

Private F As cFactory, New_c As cConstructor 'RC5-lib-related Constructor-Variables
Private mProgrFileSizeInSrc As Currency, mTotalFileSizeInSrc As Currency, mCancelled As Boolean 'Class-internal Helper-variables
 
Public Function CopyFolderTo(ByVal DstFolder As String, ByVal SrcFolder As String, Optional ByVal ApplyFileAttributesToDst As Boolean, Optional ByVal Filter As String, Optional ByVal Level As Long) As String
  On Error Resume Next 'we use "in-place-errorhandling" here, and accumulate the Errors in the return-value of this function (if there are any)
  
  If Level = 0 Then 'init (reset) the Private Variables, when we start a new "deep-copy" (at root-recursion-level Zero)
    If New_c Is Nothing Then 'when the New_c-constructor is not yet initialized,
      RaiseEvent GetFactory(F) 'retrieve a Factory over the built-in Event (to avoid specifying paths for regfree RC5-inits)
      Set New_c = F.C 'init the New_c-constructor-variable from the Factory-Property
    End If
    mCancelled = False 'reset the Cancel-Flag
    mProgrFileSizeInSrc = 0 'reset the Progress-FileSize
    mTotalFileSizeInSrc = GetTotalFileSize(SrcFolder, Filter) 'get the Total-Size of all Files (over a recursive-scan)
  End If
   
  Dim DL As cDirList, i As Long
  Set DL = New_c.FSO.GetDirList(SrcFolder, dlSortNone, Filter, True)
  If Err Then CopyFolderTo = CopyFolderTo & Err.Description & vbCrLf: Err.Clear: Exit Function
  

  New_c.FSO.EnsurePathEndSep DstFolder
  If Not New_c.FSO.FolderExists(DstFolder) Then New_c.FSO.CreateDirectory DstFolder
  If Err Then CopyFolderTo = CopyFolderTo & Err.Description & vbCrLf: Err.Clear: Exit Function

  For i = 0 To DL.FilesCount - 1 'copy the files from the current directory chunkwise
    CopyFileChunkWiseTo DstFolder & DL.FileName(i), DL.Path & DL.FileName(i)
    If Err Then CopyFolderTo = CopyFolderTo & "Error copying: " & DL.Path & DL.FileName(i) & " " & Err.Description & vbCrLf: Err.Clear
    If Cancelled Then Exit Function
    
    If ApplyFileAttributesToDst Then New_c.FSO.SetFileAttributesEx DstFolder & DL.FileName(i), DL.FileAttributes(i) And Not (FA_READONLY Or FA_HIDDEN), _
                                              DL.FileLastAccessTime(i), DL.FileLastWriteTime(i), DL.FileCreationTime(i)
    If Err Then CopyFolderTo = CopyFolderTo & Err.Description & vbCrLf: Err.Clear
  Next
  For i = 0 To DL.SubDirsCount - 1 'recursions into Sub-Directories
    CopyFolderTo = CopyFolderTo & CopyFolderTo(DstFolder & DL.SubDirName(i), DL.Path & DL.SubDirName(i), ApplyFileAttributesToDst, Filter, Level + 1)
    If Cancelled Then Exit Function
    
    If ApplyFileAttributesToDst Then New_c.FSO.SetFileAttributesEx DstFolder & DL.SubDirName(i), DL.SubDirAttributes(i) And Not (FA_READONLY Or FA_HIDDEN), _
                                            DL.SubDirLastAccessTime(i), DL.SubDirLastWriteTime(i), DL.SubDirCreationTime(i)
    If Err Then CopyFolderTo = CopyFolderTo & Err.Description & vbCrLf: Err.Clear
  Next
  If Level = 0 Then RaiseEvent Progress(1, mProgrFileSizeInSrc, mTotalFileSizeInSrc)
End Function

'Helper-Function, to determine the TotalSize (Sum of all Files in Bytes) of a given Directory (using a recursive scan)
Private Function GetTotalFileSize(ByVal SrcFolder As String, Optional ByVal Filter As String) As Currency
  On Error Resume Next
    Dim DL As cDirList
    Set DL = New_c.FSO.GetDirList(SrcFolder, dlSortNone, Filter, True)
    If Err = 0 Then GetTotalFileSize = GetTotalFileSize + DL.TotalFileSizeInDir
  On Error GoTo 0
  
  If Cancelled Then Exit Function
  Dim i As Long
  For i = 0 To DL.SubDirsCount - 1
    GetTotalFileSize = GetTotalFileSize + GetTotalFileSize(DL.Path & DL.SubDirName(i))
    If Cancelled Then Exit Function
  Next
End Function

'Helper-Function, which performs a low-level, chunk-wise copying of a file (to be able to cancel early, even when larger files >2GB are copied)
Private Function CopyFileChunkWiseTo(DstFile As String, SrcFile As String) As String
  Dim Src As cStream, Dst As cStream, BytesRead As Long
  Set Src = New_c.FSO.OpenFileStream(SrcFile, STRM_READ Or STRM_SHARE_DENY_NONE)
  Set Dst = New_c.FSO.CreateFileStream(DstFile, STRM_WRITE Or STRM_SHARE_DENY_NONE)
  
  Const BufSize As Long = 4194304: Static Buf(0 To BufSize - 1) As Byte
  Do Until Src.GetPosition = Src.GetSize
    BytesRead = Src.ReadToPtr(VarPtr(Buf(0)), BufSize)
    Dst.WriteFromPtr VarPtr(Buf(0)), BytesRead
    mProgrFileSizeInSrc = mProgrFileSizeInSrc + BytesRead
    
    Static T As Double, LastT As Double
    T = New_c.HPTimer
    If T - LastT > 0.2 Then 'ensure, that we don't raise ThreadEvents more than about 5 times per second
      If Cancelled Then Exit Function
      RaiseEvent Progress(mProgrFileSizeInSrc / mTotalFileSizeInSrc, mProgrFileSizeInSrc, mTotalFileSizeInSrc)
      LastT = T
    End If
  Loop
End Function
 
Private Function Cancelled() As Boolean 'helper-function to signalize early exits in the Job-Procedures...
  If Not mCancelled Then RaiseEvent CancelCheck(mCancelled) '...by raising the appropriate Helper-Event
  Cancelled = mCancelled
End Function
